set function 10 to space(5)
dr='n:'
f1='DOCTORS'
F2='MAIN_AREA'
SELE 1
set exclu off
use &dr&f1
index on DOC_CODE to &dr&f1
set inde to &dr&f1
go bottom
SELE 2
USE &DR&F2
SELE 1
set colo to bg+/b,w+/n
@ 7, 1 CLEA TO 23,78
@  8,  5  SAY "DOCTORS ENTRY"
@  7,  3  TO  9, 19    DOUBLE
set inte off
@ 10, 5 say 'C O D E        :    '
@ 11, 5 say 'SURNAME        :                 '
@ 12, 5 say 'FIRST NAME     :                 '
@ 13, 5 say 'MIDDLE NAME    :                 '
*@ 14, 5 say 'ALIAS NAME     :              (used)     SPECIALIST (Y/N) :  '
@ 14, 5 say 'ALIAS NAME     :              (used)'
@ 15, 5 SAY 'AUTHORIZED FOR : 1. X   2. X   3. X   4. X   5. X   (see below)'
@ 16, 7 say '[G]eneral Practice [S]pecialist  [O]ther Specialist [P]hysical Exams'
@ 17, 7 say '[E]mergency Room   [D]entist     [Y]Surgery                         '
set colo to gr+/b,w+/n
@ 16, 7 say '[G]'
@ 16,26 say '[S]'
@ 16,40 say '[O]'
@ 16,59 say '[P]'
@ 17, 7 say '[E]'
@ 17,26 say '[D]'
@ 17,40 say '[Y]'
set colo to bg+/b,w+/n
@ 18, 5 say '                                                                     '
@ 19, 5 say 'PRACTICE AS 1  :                               '
*@ 20, 5 say 'PRACTICE AS 2  :                               '
@ 21, 5 say '                                                                     '
set color to w
del_rec = 'N'
option = 1
do while option <10
   set deli off
   record_no = recno()
   kode     = doc_code
   name     = doc_name
   fname    = doc_f_name
   mname    = doc_m_name
   alias    = doc_alias
   spec     = DOC_SPE1
   auth1    = doct_auth1
   auth2    = doct_auth2
   auth3    = doct_auth3
   auth4    = doct_auth4
   auth5    = doct_auth5
   prac1    = practice_1
   prac2    = practice_2
*   if spec
*      wspec  = 'Y'
*   else
*      wspec  = 'N'
*   endif
   @ 10,22 say kode
   @ 11,22 say name
   @ 12,22 say fname
   @ 13,22 say mname
   @ 14,22 say alias
*   @ 14,65 say wspec
   @ 15,25 say auth1
   @ 15,32 say auth2
   @ 15,39 say auth3
   @ 15,46 say auth4
   @ 15,53 say auth5
   @ 19,22 say prac1
*   @ 20,22 say prac2
   do mn_form
   do case
      case option = 1
         do while .T.
            goto record_no
            kode     = spac(3)
            name     = spac(16)
            fname    = spac(16)
            mname    = spac(16)
            alias    = spac(12)
            spec     = .f.
*            wspec    = 'N'
            auth1    = spac(1)
            auth2    = spac(1)
            auth3    = spac(1)
            auth4    = spac(1)
            auth5    = spac(1)
            prac1    = spac(30)
            prac2    = spac(30)
            @ 10,22 say kode
            @ 11,22 say name
            @ 12,22 say fname
            @ 13,22 say mname
            @ 14,22 say alias
*            @ 14,65 say wspec
            @ 15,25 say auth1
            @ 15,32 say auth2
            @ 15,39 say auth3
            @ 15,46 say auth4
            @ 15,53 say auth5
            @ 19,22 say prac1
*            @ 20,22 say prac2
            set deli off
            set inte on
            @ 10,22 GET KODE PICT '@!'
            READ
            IF KODE=SPAC(3)
               EXIT
            ENDIF
            SEEK KODE
            IF EOF()
               LAYAR=SAVESCREEN(0,0,24,79)
               set colo to W+/b,w+/B
               @ 23,09 clea to 23,69
               @ 23,10 SAY 'NOT EXIST'
               WAIT ' '
               set colo to
               RESTSCREEN(0,0,24,79,LAYAR)
               loop
            endif
            if m->kode=space(3)
               exit
            endif
            EXIT
         enddo
      case option = 2
         go top
      case option = 3
         go bottom
      case option = 4
         skip
         if eof()
            go bottom
            LAYAR=SAVESCREEN(0,0,24,79)
            set colo to W+/b,w+/B
            @ 23,09 clea to 23,69
            @ 23,10 SAY 'LAST RECORD'
            WAIT ' '
            SET COLO TO
            RESTSCREEN(0,0,24,79,LAYAR)
         endif
      case option = 5
         skip -1
         if bof()
            go top
            LAYAR=SAVESCREEN(0,0,24,79)
            set colo to W+/b,w+/B
            @ 23,09 clea to 23,69
            @ 23,10 SAY 'FIRST RECORD'
            WAIT ' '
            SET COLO TO
            RESTSCREEN(0,0,24,79,LAYAR)
         endif
      case option = 6
         SET DELI OFF
         SET INTE ON
         @ 10,22 get kode   pict '@!'
         @ 11,22 get name   pict '@!'
         @ 12,22 get fname  pict '@!'
         @ 13,22 get mname  pict '@!'
         @ 14,22 get alias  pict '@!'
*         @ 14,65 get wspec  pict '!' valid wspec $ 'YN'
         @ 15,25 get auth1  pict '!' valid auth1 $ 'GSOPEDY'
         @ 15,32 get auth2  pict '!' valid auth1 $ 'GSOPEDY'
         @ 15,39 get auth3  pict '!' valid auth1 $ 'GSOPEDY'
         @ 15,46 get auth4  pict '!' valid auth1 $ 'GSOPEDY'
         @ 15,53 get auth5  pict '!' valid auth1 $ 'GSOPEDY'
         @ 19,22 get prac1  pict '@!'
         read
         LAYAR=SAVESCREEN(0,0,24,79)
         choice = ' '
         do get_optn with 'SAVE (Y/N)','YN',choice
         if choice = 'Y'
            if rec_lock()
               repl doc_code    with kode
               repl doc_name    with name
               repl doc_f_name  with fname
               repl doc_m_name  with mname
               repl doc_alias   with alias
               repl DOC_SPE1    with AUTH1
               repl doct_auth1  with auth1
               repl doct_auth2  with auth2
               repl doct_auth3  with auth3
               repl doct_auth4  with auth4
               repl doct_auth5  with auth5
               repl practice_1  with prac1
*               repl practice_2  with prac2
            endif
            unlock
         endif
         RESTSCREEN(0,0,24,79,LAYAR)
      case option = 7
         do while .T.
            kode     = spac(3)
            name     = spac(16)
            fname    = spac(16)
            mname    = spac(16)
            alias    = spac(12)
            spec     = .f.
*            wspec    = 'N'
            auth1    = spac(1)
            auth2    = spac(1)
            auth3    = spac(1)
            auth4    = spac(1)
            auth5    = spac(1)
            prac1    = spac(30)
            prac2    = spac(30)
            @ 10,22 say kode
            @ 11,22 say name
            @ 12,22 say fname
            @ 13,22 say mname
            @ 14,22 say alias
*            @ 14,65 say wspec
            @ 15,25 say auth1
            @ 15,32 say auth2
            @ 15,39 say auth3
            @ 15,46 say auth4
            @ 15,53 say auth5
            @ 19,22 say prac1
*            @ 20,22 say prac2
            set deli off
            set inte on
            go bott
            kode=str((val(doc_code)+1),3)
            @ 10,22 GET KODE PICT '@!'
            READ
            IF KODE=SPAC(3)
               EXIT
            ENDIF
            SEEK KODE
            IF .NOT. EOF()
               LAYAR=SAVESCREEN(0,0,24,79)
               set colo to W+/b,w+/B
               @ 23,09 clea to 23,69
               @ 23,10 SAY 'EXIST'
               WAIT ' '
               SET COLO TO
               RESTSCREEN(0,0,24,79,LAYAR)
               loop
            endif
            if m->kode=space(3)
               exit
            endif
            @ 11,22 get name   pict '@!'
            @ 12,22 get fname  pict '@!'
            @ 13,22 get mname  pict '@!'
            @ 14,22 get alias  pict '@!'
*            @ 14,65 get wspec  pict '!' valid wspec $ 'YN'
            @ 15,25 get auth1  pict '!' valid auth1 $ 'GSOPEDY'
            @ 15,32 get auth2  pict '!' valid auth1 $ 'GSOPEDY'
            @ 15,39 get auth3  pict '!' valid auth1 $ 'GSOPEDY'
            @ 15,46 get auth4  pict '!' valid auth1 $ 'GSOPEDY'
            @ 15,53 get auth5  pict '!' valid auth1 $ 'GSOPEDY'
            @ 19,22 get prac1  pict '@!'
*            @ 20,22 get prac2  pict '@!'
            read
*            if wspec='Y'
*               spec=.t.
*            else
*               spec=.f.
*            endi
            LAYAR=SAVESCREEN(0,0,24,79)
            choice = 'Y'
            do get_optn with 'SAVE (Y/N)','YN',choice
            if choice = 'Y'
               if fil_lock()
                  append blank
               endif
               if rec_lock()
                  repl doc_code    with kode
                  repl doc_name    with name
                  repl doc_f_name  with fname
                  repl doc_m_name  with mname
                  repl doc_alias   with alias
                  repl DOC_SPE1    with AUTH1
                  repl doct_auth1  with auth1
                  repl doct_auth2  with auth2
                  repl doct_auth3  with auth3
                  repl doct_auth4  with auth4
                  repl doct_auth5  with auth5
                  repl practice_1  with prac1
*                  repl practice_2  with prac2
               endif
               unlock
               NOR=RECNO()
            else
               LOOP
            endif
            anext = 'N'
            do get_optn with 'ADD ANOTHER ONE (Y/N)','YN',ANEXT
            if ANEXT= 'Y'
               GOTO NOR
               @ 23,09 clear to 23,69
               RESTSCREEN(0,0,24,79,LAYAR)
               loop
            ELSE
               EXIT
            ENDIF
         enddo
      case option = 8
         LAYAR=SAVESCREEN(0,0,24,79)
         choice = 'N'
         do get_optn with 'Delete (Y/N)','YN',choice
         if choice = 'Y'
            if rec_lock(0)
               delete
            endif
            unlock
            del_rec = 'Y'
            go bottom
         endif
         RESTSCREEN(0,0,24,79,LAYAR)
      case option = 9
         tampil=savescreen(0,0,24,79)
         go top
         SET COLO TO BG+/B,w+/n
         clea
         @ 01,1 TO 01,78 DOUBLE
         @ 03,1 TO 03,78 DOUBLE
         @ 02,1  SAY "CODE ALIAS NAME   N A M E          SP  AUTH'D FOR  P R A C T I C E    A S"
*CODE ALIAS NAME   N A M E          SP  AUTH'D FOR  P R A C T I C E    A S
*X-X  X----------X X--------------X  X   X X X X X  X-----------------------X
*         1         2         3         4         5         6         7
*123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789
         BR=3
         DO WHILE .NOT. EOF()
            IF BR>=20
               SET CURSOR OFF
               SET COLO TO R+/B,W+/N
               @ 24,24 say "**   F1-Exit      F2-Continue   **"
               SET COLO TO BG+/B,W+/N
               do while .t.
                  store 0 to mx,ws
                  do while mx=0
                     mx=inkey()
                  enddo
                  if mx=28
                     ws=1
                     exit
                  else
                     if mx=-1
                        ws=0
                        SET COLO TO BG+/B,w+/n
                        @ 05,1 clea to 23,78
                        exit
                     endif
                  endif
               enddo
               SET CURSOR ON
               IF WS=1
                  EXIT
               ENDIF
               BR=3
            ENDIF
            BR=BR+2
            @ BR,1  say doc_code
            @ BR,6  say doc_alias
            @ BR,19 say doc_name
*            if doc_spec
*               wspec='Y'
*            else
*               wspec='N'
*            endi
*            @ BR,37 say wspec
            @ BR,41 say doct_auth1
            @ BR,43 say doct_auth2
            @ BR,45 say doct_auth3
            @ BR,47 say doct_auth4
            @ BR,49 say doct_auth5
            @ BR,52 say practice_1
            SKIP
            IF EOF()
               DO DISP_MSG WITH 'TYPE ANY KEY'
               EXIT
            ENDIF
         ENDDO
         GOTO RECORD_NO
         RESTSCREEN(0,0,24,79,TAMPIL)
      other
         loop
   endcase
enddo
if del_rec='Y'
   IF NET_USE("&DR&F1",.T.,'1',10)
      pack
      set inde to &dr&f1
      rein
   ENDIF
endif
close index
close data
set inte on
return

